unit Time;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls;

const
  N = 10000;
  D = 10;
  H = 20;

type
  TForm1 = class(TForm)
    Image1: TImage;
    Timer1: TTimer;
    BitBtn1: TBitBtn;
    procedure BitBtn1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    procedure BubbleSort (arr: array of Integer);
    procedure AdvancedBubbleSort (arr: array of Integer);
    procedure ShakerSort (arr: array of Integer);
    procedure HeapSort (arr: array of Integer);
    procedure Heapify(num: Integer);
    procedure SelectionSort (arr: array of Integer);
    procedure DoArr;
    procedure Draw;
    { Public declarations }
  end;

var
  Form1: TForm1;
  mass, arr: array of Integer;
  tShS, tBS, tABS, tHS, tSS, x, y, w: Integer;
  a: Real;

implementation

{$R *.dfm}

procedure TForm1.AdvancedBubbleSort(arr: array of Integer);
var
  flag: Boolean;
  i, j, p: Integer;
begin
  for i:=0 to N-2 do
  begin
    flag:=False;
    for j:= 0 to N-i-2 do
    begin
      if (arr[j] > arr[j+1]) then
      begin
        p:=arr[j];
        arr[j]:=arr[j+1];
        arr[j+1]:=p;
        flag:=True;
      end;
    end;
    if flag = False then
    begin
      Break;
    end;
  end;
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var
  i: Integer;
begin
  a:=1;
  tShS:=0;
  tBS:=0;
  tABS:=0;
  tHS:=0;
  tSS:=0;
  Timer1.Enabled:=True;
end;

procedure TForm1.BubbleSort(arr: array of Integer);
var
  i, j, p: integer;
begin
  for i:=0 to N-1 do
  begin
    for j:= 0 to N-1 do
    begin
      if (arr[j] > arr[j+1]) then
      begin
        p:=arr[j];
        arr[j]:=arr[j+1];
        arr[j+1]:=p;
      end;
    end;
  end;
end;

procedure TForm1.DoArr;
var
  i: Integer;
begin
  for i:=0 to N-1 do
  begin
    arr[i]:=mass[i];
  end;
end;

procedure TForm1.Draw;
var
  yBS, yABS, yHS, yShS, ySS: Integer;
begin
  Image1.Canvas.Rectangle(ClientRect);

  yBS:=D;
  Image1.Canvas.Rectangle(D, yBS, D + Round(tBS*a), yBS+H);
  Image1.Canvas.TextOut(Round(tBS*a) + 2*D, yBS + (D div 2), 'Bubble Sort time: ' + IntToStr(tBS));

  yABS:=yBS + H + D;
  Image1.Canvas.Rectangle(D, yABS, D + Round(tABS*a), yABS+H);
  Image1.Canvas.TextOut(Round(tABS*a) + 2*D, yABS + (D div 2), 'Advanced Bubble Sort time: ' + IntToStr(tABS));

  yShS:=yABS + H + D;
  Image1.Canvas.Rectangle(D, yShS, D + Round(tShS*a), yShS+H);
  Image1.Canvas.TextOut(Round(tShS*a) + 2*D, yShS + (D div 2), 'Shaker Sort time: ' + IntToStr(tShS));

  ySS:=yShS + H + D;
  Image1.Canvas.Rectangle(D, ySS, D + Round(tSS*a), ySS+H);
  Image1.Canvas.TextOut(Round(tSS*a) + 2*D, ySS + (D div 2), 'Selection Sort time: ' + IntToStr(tSS));

  yHS:=ySS + H + D;
  Image1.Canvas.Rectangle(D, yHS, D + Round(tHS*a), yHS+H);
  Image1.Canvas.TextOut(Round(tHS*a + 2*D), yHS + (D div 2), 'Heap Sort time: ' + IntToStr(tHS));
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  SetLength(mass, N);
  SetLength(arr, N);
end;

procedure TForm1.Heapify(num: Integer);
var
  ah, bh, kh: Integer;
begin
  while (0 = 0) do
  begin
    ah:=2000000000;
    bh:=2000000000;
    if (2*num + 1 < N) then
    begin
      ah:=arr[2*num + 1];
    end;
    if (2*num + 2 < N) then
    begin
      bh:=arr[2*num + 2];
    end;
    if (ah <= bh) and (ah < arr[num]) then
    begin
      kh:=arr[num];
      arr[num]:=arr[2*num+1];
      arr[2*num+1]:=kh;
      num:=2*num+1;
    end else if (bh <= ah) and (bh < arr[num]) then
    begin
      kh:=arr[num];
      arr[num]:=arr[2*num+2];
      arr[2*num+2]:=kh;
      num:=2*num+2;
    end else begin
      Break;
    end;
  end;
end;

procedure TForm1.HeapSort(arr: array of Integer);
var
  i, mh, kh: Integer;
begin
  for i:=N-1 downto 0 do
  begin
    Heapify(i);
  end;
  mh:=N;
  for i:=0 to mh-1 do
  begin
    kh:= arr[0];
    arr[0]:= arr[mh-1];
    arr[mh-1]:=kh;
    Dec(mh);
    Heapify(0);
  end;
  mh:=N;
end;

procedure TForm1.SelectionSort(arr: array of Integer);
var
  i, j, max, nor: Integer;
begin
  max:=0;
  for i:= 0 to N-2 do
  begin
    for j:=0 to N-i-1 do
    begin
      if (arr[j]>=max) then
      begin
        max:=arr[j];
        nor:=j;
      end;
    end;
    arr[nor]:=arr[N-i-1];
    arr[N-i-1]:=max;
    max:=0;
  end;
end;

procedure TForm1.ShakerSort(arr: array of Integer);
var
  i, j, ls: Integer;
  flag: Boolean;
begin
  for i:=0 to (n div 2) do
  begin
    flag:= True;
    for j:=i-1 to N-i-1 do
    begin
      if arr[j] > arr[j+1] then
      begin
        ls:=arr[j];
        arr[j]:=arr[j+1];
        arr[j+1]:=ls;
        flag:=false;
      end;
    end;
    for j:=N-i-1 downto i-1 do
    begin
      if arr[j] < arr[j-1] then
      begin
        ls:=arr[j];
        arr[j]:=arr[j-1];
        arr[j-1]:=ls;
      end;
    end;
    if flag = True then
    begin
      Break;
    end;
  end;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
var
  maxlt, maxl, t, i: integer;
  name: String;
begin
  Randomize;
  for i:= 0 to N-1 do
  begin
    mass[i]:=Random(1000);
  end;

  DoArr;
  t:=GetTickCount;
  BubbleSort(arr);
  tBS:= tBS + GetTickCount - t;

  DoArr;
  t:=GetTickCount;
  AdvancedBubbleSort(arr);
  tABS:= tABS + GetTickCount - t;

  DoArr;
  t:=GetTickCount;
  SelectionSort(arr);
  tSS:= tSS + GetTickCount - t;

  DoArr;
  t:=GetTickCount;
  HeapSort(arr);
  tHS:= tHS + GetTickCount - t;

  DoArr;
  t:=GetTickCount;
  ShakerSort(arr);
  tShS:= tShS + GetTickCount - t;

  {maxt:=0;
  if maxt < tBS then
  begin
    maxt:=tBS;
    name:='Bubble Sort time: ';
  end;
  if maxt < tABS then
  begin
    maxt:=tABS;
    name:='Advanced Bubble Sort time: ';
  end;
  if maxt < tShS then
  begin
    maxt:=tShS;
    name:='Shaker Sort time: ';
  end;
  if maxt < tSS then
  begin
    maxt:=tSS;
    name:='Selection Sort time: ';
  end;
  if maxt < tHS then
  begin
    maxt:=tHS;
    name:='Heap Sort time: ';
  end;

  w:=Image1.Canvas.TextWidth(name + IntToStr(maxt)) + 3*D;
  a:=(Image1.Width - w)/(maxt);  }

  maxl:=0;
  if maxl < tBS*a + Image1.Canvas.TextWidth('Bubble Sort time: ') then
  begin
    maxl:=Round (tBS*a) + Image1.Canvas.TextWidth('Bubble Sort time: ');
    maxlt:= tBS;
    name:='Bubble Sort time: ';
  end;
  if maxl < tABS*a + Image1.Canvas.TextWidth('Advanced Bubble Sort time: ') then
  begin
    maxl:=Round (tABS*a) + Image1.Canvas.TextWidth('Advanced Bubble Sort time: ');
    maxlt:= tABS;
    name:='Advanced Bubble Sort time: ';
  end;
  if maxl < tShS*a + Image1.Canvas.TextWidth('Shaker Sort time: ') then
  begin
    maxl:=Round (tShS*a) + Image1.Canvas.TextWidth('Shaker Sort time: ');
    maxlt:= tShS;
    name:='Shaker Sort time: ';
  end;
  if maxl < tSS*a + Image1.Canvas.TextWidth('Selection Sort time: ') then
  begin
    maxl:=Round (tSS*a) + Image1.Canvas.TextWidth('Selection Sort time: ');
    maxlt:= tSS;
    name:='Selection Sort time: ';
  end;
  if maxl < tHS*a + Image1.Canvas.TextWidth('Heap Sort time: ') then
  begin
    maxl:=Round (tHS*a) + Image1.Canvas.TextWidth('Heap Sort time: ');
    maxlt:= tHS;
    name:='Heap Sort time: ';
  end;

  w:=Image1.Canvas.TextWidth(name + IntToStr(maxlt)) + 3*D;
  a:=(Image1.Width - w)/(maxlt);

  Draw;
end;

end.
